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MODULE FORSSFMT_INTRP (2T ui “Fortran Format Statement 
POENT Bee " ! File: FORFMTI 


$3: 
2: 
Int 
NT. : $BL2037 
BEGIN 
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'* COPYRIGHT (c) 1978, 1980, 1982, 1984 B 
!® DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. 
'# ALL RIGHTS RESERVED 


Hd me SOFTWARE IS FURNISHED UNDER A LICENSE A 
:* ONLY IN ACCORDANCE WITH THE TERMS OF SU 
; NCLUSION OF THE ABOVE COPYRIGHT NOTICE. THI 

P DED OR OTHERW 


® 
*® 
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® 
ND ° 
CH * 
S ve 
i ROV 0 IS * 
ie OTHER PERSON. NO TITLE TO AND OWNERSHIP OF T * 
ie TRANSFERRED. : 
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it THE INF ORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * 
i# AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
i CORPORATION. * 
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ix DIGITAL ASSUMES NO RESPONSIBIL 
ie SOFTWARE ON EQUIPMENT WHICH IS 
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ITY FOR THE USE OR ng OF ITS 
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1 ++ 
i FACILITY: FORTRAN 
i ABSTRACT: | 


This module interprets FORTRAN format statements 

which have been pre-compiled into an encoded form by either the 
FORTRAN compiler or the run-time format compiler 
FORSSFMT_COMPIL. It is socepencent of READ and "WRITE semantics 
and is executed at both the READ Formatted and WRITE Formatted 
User Data Formatters (UDF) level of abstraction. 
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i MODIFIED BY: 
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Peter Yuo, ejoFeb=?7, Version 1 
Original 


Richard Grove, 19-Aug-77, Versio 
(Pre fous ott mietory removed. SBL 33. “hyg-19823 
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4 defaults for 0 and, agoraet width when value is not 1, 2, 4, 8 or 

5 48° bytes. SBL 29-D Bes"? 

5 ! 6-037" Improved fix for 2-0 OE of Joel CLinkenbeard. SBL 8-Jan-1981 

; -034 - yey ct FORSSERT_ INTREI to JSB Linkage for better performance. 

-Jul-1 | 

5 2-035 - Miscellaneous per formance enhancements: JAW 29-Jul-1981 

05 Check for certain specific one-byte format codes at the outset 

05 and special-case them, : 
05 For all format codes, if optional second byte is not present, 
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' bypass checks for VFEs and for optional forms of RC and WwW. 
; Brea i ACT into ive tables, eee? having rg entries, 

: placing the special action in ACT.2 and nercetios the 

: need for special action with thee feuteeder bit of FI_ACT. 

' Select a ‘Wlicean action onty f this bit is se 

! For codes through 7? check for slenent size of 4 first. 
i Narrow the-scope of ACT, FMT_REPR and P, which are not needed 
i in the outermost b biset tor conserve re pk, 

i Replace CASE on V_RC \otpe with IF ... THEN to ayoid an 1§A32¥- 
: - -036 - correct range check of P value ies VFEs. SBL Aug-1 

' 2-037 = Allow zero-yalue VFEs for W, D and E flelds only. Use prologue 
file. SBL 26-Apr-1983 
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CORSSFATINTRP Fortran Format Statement Interpreter 


; PROLOGUE FILE: 


L 
P; 


FORWARD ROUTINE 
FORSSFMT_INTRPO : 
FORSSFMTINTRP1 : 


MACROS: 

NONE 
EQUATED SYMBOLS: 
NONE 
OWN STORAGE: 

NONE 


EXTERNAL REFERENCES: 


EXTERNAL ROUTINE 


N:FORPROLOG'; 


JSB_FMTO NOVALUE, 
JSB 


“FMT1 NOVALUE; 


FORSSSIGNAL_STO : NOVALUE, 


FORS$SIGNAL : NOVALUE; 


f 13 
16-Sep-19 
14-Sep-19 


4 00:25:1 AX-11 Bliss-32 V4.0-74 
4 99:43:4 FORRTL. SRC IFORFMTINT-B 231 


FORTRAN Definitions 
Optimize for speed 


initialization 
Interpret until a data format code 


Fignet stop FORS_abcmnoxyz, given 

short) Fortran é@rror number (FORS$K_abcmnoxyz) 
as a peroneter 

Signal FORS_abcmnoxyz, given (short) 


' FORTRAN error number (FORSK_abcmnoxyz) 
! as a parameter. 
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FMT_INTRP Fortran Format Statement Interpreter 16S on 18ae 00:25:1 AX=-11 Bliss-32 V4.0-74 Page 4 
14-Sep-1984 12:52:0 FORRTL.SRCJFORFMTINT.B52;1 (3) | 
17 GLOBAL ROUTINE FORSSFMT_INTRPO ! Format interpreter initialization | 
\f : JSB_FMTO NOVALUE = 
01 144 | 
01 ' 
9 FUNCTIONAL DESCRIPTION: 
018 ; Initializes the format interpreter | 
O18 i IMPLICIT INPUTS: | 
018 CCB Contains adr. of current LUB/ISB/RAB. | 
19 { IMPLICIT OUTPUTS: | 
019 i CCB CISBSW_FMT_REPJ Set repeat count to 0 to indicate no repeat | 
019 ! for this statement yet. 
019 . CCB CISB$B_FMT_PJ Set P scale factor to 0 for this statement | 
O19 CCB CISBSA_FMT_PTRI ih he A format pointer to 
' eginnin 
813 } CCB CISBSW_FMT_REVERJ offset of current format reversion | 
: oin 
1? } CCB CISBSB_FMT_DEPJ Bepth of repeat group pushdown stack 
i SIDE EFFECTS: | 
; NONE 
= 
BEGIN | 
EXTERNAL REGISTER 
CCB : REF SFORSCCB_DECL; 


CCB CISBSW_FMT_REP) = 0; 


| 
| 
Set repeat count to 0 to indicate no repeat for this statement. 
i 
| 
7 + 
Set P scale factor to 0 for this statement (no scaling). | 


CCB CISBSB_FMT_P) = 0; 


'¢ 
Set format flags to zero for this statement. 


CCB CISBSW_FMT_FLAGS) = 0; 
i] 


'¢ 
Set BN flag if LUBSV_NULLBLNK is set 
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CCB CISB$V_BN) = .CCB CLUBSV_NULLBLNKI; 


Set current format position to beginning of format. 


CCB CISBSA_FMT_PTR] = .CCB CISBSA_FMT_BEG); 


i Initialize format reversion point to beginnin 
i byte array. The reversion point is used when 


i more user data elements than data format codes 


CCB CISBSW_FMT_REVER] = 


i Initialize pyrene re 
3 to empty (-1) 


CCB CISBSB_FMT_DEP) = - 


_Since it is a 16-bit offset with respect to 1S8SA_ FMT_BEG, set to 0. 


at grove pysh down stack depth 
item, = items in stack, etc. 


ize ISB$B_FMT_CODE to zero, which will t 


CCB CISB$B_FMT_CODE) = 


i ALL other ISB locations and flags have alread 
d to 0 or a specified value by the 


ell 
9 not to Call FORSSUDF_WF1 unless share were no 
nthe 1/0 List. 


a initiolizetion for this’ 1/0 statement. 
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of format 
here are 


been 
/0 statement 


! End of routine FORSSFMT_INTRPO 
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- IDENT 


-EXTRN 
~EXTRN 


-PSECT 
AB B4 00000 FORSSFMT_INTRPO:: 
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1 
16-S 
14-$ 
GLOBAL ROUTINE FORSSFMT_INTRP1 ' Cornet interpret until data code 
: (EL_SIZE, ! Size in addressable units of data elements 
' This ar — is passed in 
! external register EL_SIZE. 
' 1 if data transmitter seen 
! This argument is passed in 
! external register DT_SEEN. 
! Value is format code ; | 
} Returned in external register 


DT_SEEN) 


: JSB_FMT1 NOVALUE = 


MMITOPNITOPoToTrTr 
END me a ed ed ed ed ed 
OOONOULS WI 


te 
! FUNCTIONAL DESCRIPTION: 


FORSSFMT_INTRP1 interprets FORTRAN format statements 

which have been precompiled into an encoded form by either 
the FORTRAN compiler or the run-time format compiler, 
FORSFMT_COMPIL. Only FORSSFMT_INTRP1 understands the structure 
and encoding of compiled format statements. Furthermore, 

it is independent of READ and WRITE semantics. 

Each call to FORSSFMT_INTRP1 processes as many format 

codes as possible unt7l it encounters one which 

needs to access user program data, needs to access the 
data buffer, or depend on whether read or write. This 
block is independent of whether a READ or WRITE is 
being performed. It is invoked in both the formatted 
READ and WRITE user data formatter routines (UDF). 


1 

i 

i 

! 

i 

' 

i 

i 

' 

i 

i 

i 

} 

} 

} 

: Note: being compatible with -11 OTS, there is a 
: difference between nf and n(f) in that VFE's are evaluated only 
: once for the former and each time for the Latter. The former 
: is termed, repeating a format code while the Latter is 
termed a repeat group. 
IMPLICIT INPUTS: 

i 

i 

! 

i 

i 

i 

i 

i 

' 

i 

i 

i 

i 

! 

i 

i 

i 

i 

i 

i 


EL_SIZE Size in addressable units of user 

data element. Used to set default 

widths (W) for default format. 

A value of 0 indicates that this is 

the end of the I/0 List call and there is 
no user 1/0 List element to be transmitted. 
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DT_SEEN 1 if a data transmitter has been seen by 
the current call to the UDF Level, 0 
otherwise. If it is set, we don't evaluate 
format items for data transmitters. 
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OTS$$A_CUR_LUB Adr. of current logical unit block 
(LUB) Used to setup base (ISB) to 
1/0 statement block. 
The following locations are set only by previous calls to 

FORSSFMT_INTRP1, i.e., are effectively OWN: 


CCB CISBSA_FMT_PTRJ Adr. of next byte in compiled 
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FORSSFMT_INTRP Fortran Format Statement Interpreter 16-Sep-1984 09: 5:1 AX-11 Oi legen V4.0-74 
2-037 14-Sep-1984 12:52:0 FORRTL.SRCJFORFMTINT.B52;1 (4) | 
: 269 eS format byte array. A value of 0 | ; 
: 270 ¢ i indicates that this is the end of the : 
s eri 1! 1/0 List call and there is no user | ‘ 
3 ie 0334 1! /0 List element to be transmitted. : 
; ef 0355 1! CCB CISB$V_USER_ELEM) until a user element format : 
> 274 0336 1! code seen. Infinite loop preventer : 
; 275 0337 1! CCB CISBSW_FMT_REPJ Current format code repeat count (n) ; 
; 276 0338 1! or 0 if not repeating a single | : 
5 ere 0339 1! format code. Note: the repeat ; 
: 278 0340 1! count for a repeat group is kept : 
; 6 034, } in the top of the format stack, not here. : 
; 281 0 rk 1; CCB Hest rel he Adr. of beginning of format statement : 
; see 0344 1! CCB CISBSB_FMT_DEP Depth of repeat group format pushdown stack. : 
; 0345 1! CCB CISBSW_FMT_STKP] Stack of offsets to beginning of repeat groups | : 
; 284 0346 1! CCB CISBSW_FMT_STKRJ Stack of group repeat counts . 
3 €80 0347 1! CCB CISBSW_FMT_REVER) Offset of current format reversion ; 
; 286 0348 1! point to revert to when end of format ; 
; 287 0349 1! statement is encountered with more data : 
; 288 0350 1! elements to be transmitted. : 
3; or 0351 1! CCB CISBSV_USER_ELEM] Flag: 1 if seen a user data element format code, : 
; 290 Oe26 1! 0 if not. Used to check for infinite format loop : 
; $3) O327 ! in which no user data element format codes are present | ; 
; $38 0355 1 ! IMPLICIT OUTPUTS: | : 
> 294 0356 1! $ 
: 295 0357 1! The oh levies are outputs only to a successive call to | ; 
; $38 O35 ' FORSSFMT_INTRP{O,1}, i.e., are effectively OWN. | : 
; 0360 1! CCB CISBSV_USER_ELEM] 0 if no user data element format : 
: $32 0361 1! code seen this repeat group, | . 
; 300 0306 , 3 if one or more $ 
3 301 0363 1! CCB CISBSW_FMT_REP] Current format code repeat count (n) ; 
: 302 0364 1! or 0 if not repeating a single | ; 
3 Woe 0365 1! format code. Note: the repeat F 
; 304 0366 1! count for a repeat group is kept | PF 
: 305 0367 1! in the top of the format stack, not here. : 
; 306 0368 1! CCB CISBSB_FMT_DEP) Depth of repeat group format pushdown stack. ; 
; 307 0369 1! CCB CISBSW_FMT_STKP] Stack of offsets to beginning of repeat groups $ 
; 308 0370 1! CCB CISBSW_FMT_STKRJ Stack of group repeat counts 3 
; 309 0371 1! CCB LISBSW_FMT_REVER] Offset of current format reversion ; 
; 310 0376 1! point to revert to when end of format | : 1 
: 311 0373 1! statement is encountered with more data 3 | 
3 318 o37e : elements to be transmitted. : 
3; 314 0376 1! The following are output to available to the caller (read 3] 
: 1? Bare : or write user data formatter): : 
3 6317 0379 1! CCB CISBSA_FMT_PTR) Adr. of next byte to be read from | 3] 
; 318 0380 1! the compiled format statement byte array 3 | 
3; 519 83 ae are pushed as a pair. : | 
: 320 3 3 1! CCB CISBSB_FMT_P Signed scale factor (P) 3 | 
; $) } ia CCB LISBSW_FMT_W Unsigned width of field (Ww) : 3 | 
3 § the 1! CCB CISBSB_FMT_D Unsigned number of digits in fraction (D) 3] 
i ie 32 1! CCB CISBSB_FMT_E nsigned number of characters 3 | 
3: 324 3 § 1! n exponent (E). 3] 
3 seo 0387 1! CCB CISBSV_USER_ELEM) Flag: 1 if seen a user data element format code, 31 
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| 
0 if not. Used to check for infinite format loop | 
| 
| 


in which no user data element format codes are present 


or els Te] 
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SIDE EFFECTS: 
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FUN -OOONO 


SIGNAL_STOPs FORS_SYNERRFOR (62="SYNTAX ERROR IN FORMAT'') 
SIGNAL-STOPs FORS_INFFORLOP (60="INFINITE FORMAT 400P") 
SIGNAL-STOPs FORS_VFEVALERR (68="VFE VALUE ERROR'') 
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> 44 8306 
> 44 50 + 
; 448 0508 ' (NXTITM4+1) 
> 449 0509 ! Assume that a format code is being repeated.- nf not n(f). 
: 450 0510 ' (as Stet inguished from a repeat group which is n(...)) 

; 451 0511 ! Decrement format repeat count (ISB$W_FMT_REP). Test | 
; t2g Baig ! if still more to repeat - if yes, skip uSual format code 
. 43 051 ! dispatching by skipping toes altogether, redo defaults if 
: +28 pele default format codes and RETURN 
: 486 0516 | 
: rtt4 b2if r@ CISBSW_FMT_REP] GTR 1 
; 459 0519 BEGIN 
: 460 0520 
; 461 b2¢) LOCAL 
: ro O3$8 ACT : BLOCK C1, LONG]; ! Action table entry for format code 
© | 
> 464 b2$¢ FMT_CODE = 2608 CISB8$B_FMT_CODE); | 
3; 465 0525 ACT = .FI_ACT C.FMT_CO : 
: 466 0326 3 IF DT-SEEN AND .ACT CFI_STOP | 
: 468 0528 4 BEGIN 
: 2% 0850 RETORN;, | 
> 471 0531 3 END; 

P4 rth} b33¢ H CCB CISBSW_FMT_REP) = .CCB CISBSW_FMT_REP] - 1; 

> 474 0534 2 ELSE 
: 475 0535 2 
; 476 0536 § + 
3 477 0537 ' (FINTRP) 
; 478 0538 2 ! Not in format code repeat - start format interpret loop 

3; 479 0539 2 ' Loop until encounter a format code which needs to access 
; 480 0540 2 ! data (ER or explicit or default Q@, A, L, 0, I, Z. Ff, E, G, or D), 
; «481 0541 § ! meeds to access the data buffer (X, H, Q), or 
3 one Beg § } depends on whether read or write (), /, $, :, T). | 
> 484 0544 ¢ 
> 485 0545 BEGIN 
: 486 0546 3 
3; 487 0547 3 REGISTER 
: 488 0548 . ! Pointer to format byte stream 

3 $39 B26? ACT : BLOCK (1, LONG); ! Action table entry for format code 

5 $33 B22) P = .CCB CISBSA_FMT_PTRI; 

; 493 §a33 DO 

: 494 0554 4 BEGIN 
3; 495 0555 4 
: 496 9326 4 '¢ : 
; 497 0557 4 ! Pickup next format code byte from compiled format: 

: 498 0558 4 ! If optional representation byte 

; 499 Bean 4 ' is present (V_FMT_REPRE=1), mask out flag bit 

: 500 560 4 ! in format code and copy next byte to BITVECTOR 

: 501 0561 4 ! to indicate Larger (Less frequent) sizes of the 

; 502 0562 4 ! code representation or Variable Field Expressions (VFE). 
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THEN 


-Sep- FORRTL.SR MT 
CXE TO xG] : 
BEGIN 
CCB CISBSW_FMT_W] = RBYTE_A (P); 
CCB LISBSB_FMT_DJ = RBYTE_A (P); 
CCB LISBSB_FMT_EJ = RBYTE_A (P); 
CCB LISBSW_FMT_REP] = 1; 
CCB CISBSV_USER_ELEM) = 1; 
lwo: ! Indicate special case found 
(29, OUTRANGE] : 
0; ! Indicate special case not found 
TES) 
BEGIN 


'+ 


Get RC, W, D and E in the traditional, fully qoneee 
Bers Seg laeing check for VFE's and alternate forms of 


Optimization: 


If optional second byte is not present, bypass check 
for VFE's and alternate forms of W and RC. 


Cen” TESTBITSC (FMT_CODE CV_FMT_REPRE]) 


BEGIN ! Begin short form 
CCB CISBSW_FMT_REP) = 1; 
IF .ACT CFY_GETw) 
THEN 
BEGIN 
CCB CISBSW_FMT_W] = RBYTE_A (P); 
IF .ACT CFI_GETDI 
THEN 
BEGIN 
CCB CISBSB_FMT_DJ = RBYTE_A (P); 
ean! CFT_GETE) 
CCB CISBSB_FMT_E] = RBYTE_A (P); 
END; 
END; 
END ! End short form 
ELSE 
BEGIN ! Begin long form 


LOCAL 
FMT_REPR : BLOCK [1, LONG]; 


FMT_REPR = RBYTE_A (P); 


'¢ 

' Get repeat count (RC) from format a save in ISBSW_FMT_REP. 
' If repeat count is a VFE (FMT_REPRLV_RC_VFEJ=1), get VFE and 
' check for out of range (1:32767). 

! If explicitly represented, get byte or word value. 


snr es 
INT.B52;1 
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617 0677 
618 ote 
619 67 

620 680 
621 0681 
6 ¢ Bees 
6 068 

624 0684 
625 0685 
626 0686 
627 0687 
628 begs 
629 0689 
630 0690 
631 0691 
632 069 

633 069 

634 0694 
635 0695 
636 0696 
637 0697 
638 0698 
639 0699 
640 0700 
641 0701 
642 144 
645 070 

644 0704 
645 0705 
646 0706 
647 0707 
648 0708 
649 0709 
650 0710 
651 0711 
652 0712 
653 0713 
654 0714 
655 0715 
656 0716 
657 0717 
658 0718 
659 0719 
660 879 
661 721 
662 0758 
663 072 

664 0724 
665 725 
666 18 
667 7 

668 7 $ 
669 7 

670 730 
672 at 
675 0738 
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' Else set repeat count to 1. Possible for left paren 
! of a repeat group (NLP) or A, L, 0, Z, I, F, E, G, D 
;_or default A, L, 0, Z, I, F, E—, G, D. 


CcB earn amera = (IF .FMT_REPR CV_RC_VFEJ 
BEGIN ' Process RC VFE 

LOCAL 

T: 


= CALL_VFE (P); 


T 
IF .1 GEQU 32768 OR .T EQL 0 
THEN 


BEGIN 
FORSSSIGNAL (FORSK_VFEVALERR); 
Lae ' Force repeat count to 1 on error 
ELSE 
at !' Use user ci value 
END ! End of RC VFE processing 
ELSE 


! The following assumes that RC is either 00 

' (absent), 01 (byte) or 10 (word), and that 

! it cannot be 11. 

if ght Bre Cv_RC_TYPE_BYTE) 

“as RBYTE_A (P) ! RC is a byte 
If .FMT_REPR CV_RC_TYPE_WORD] 


” pes (P) ! RC is a word 


1); ! RC is absent 
14+ 
! P, 1, X, WH, AL, O. I, 2, Ff. E. G, D: 
i Get field width (w) from format and 
' set ISBSW_FMT_W. If width field is a 
! VFE (V_W OFE=T), get VFE value and check range; 
! if P stale -128 to 127, else (field width w) 0 to 32767. 
! If width of field is a byte (V_W_WORD=0), get byte 
' else get word. ISBSW_FMT_W is set as a 
zero extended word. 


IF .ACT CFI_GETW) 
THEN 


W_FMT_W] = (IF .FMT_REPR CV_W_VFE] THEN 


—o 
ze 
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LOCAL 
T = CALL_VFE (P) 
IF .FMT_CODE EQL _P 
THEN 
BEGIN ! P scale 
ae -1<0,8,1> NEQ .T ! P between -128 and 127? 
BEGIN 
oly ‘aati (FORSK saath we 
= 0 ! Force P scale to 0 
END 
END 
ELSE 
BEGIN ! Else w width of field 


IF .1 GEQU 32768 
THEN 


BEGIN 
FORS$SIGNAL (FORSK_VFEVALERR) ; 
END 


' return VFE value 
.FMT_REPR CV_W_WORD] THEN RWORD_A (P) ELSE RBYTE_A (P)); 


cimal part (d) from format and set 
FMT_D. If decimal part is a VF 
QFE=T) get VFE and check range (0:32767). 


de 
B 
“get byte from format 


t 
B 
s 
t 


default exponent width to 2. 


IF .ACT CFI_GETDI 


CONAUESWN OOO NAMES WN OO OONAULS WN OO OONOUS WN O 


MNONRONORO RD 
——OQOCOOCOOO CONN NNN NN NNN NOOO OR OS "OOOO OO 2] S| | “DOCOWWOWOOowowow 


SOOOOSOOCOCOOCSOOCOCOOCSOCOOCOSOOOCSSOCSOOCSOOCOOCOC OOOO COOOCOOOCOOOOOOOOOOOO 


SQN NNN NNN 


WCOCOOO COCO COCO OOOO SI NIN NINN NS 


70 
7 
7 
7 
? 
7 
7 
7 
7? 
7? 
? 
7? 
7 
7 
7 
7 
7? 
7 
7 
7? 
7 


OOONOUEWN—OV0On 
SOWONOUSWN OO 


a ae nt ts st 


Witorofor 


BEGIN 
CCB CISBSB_FMT_DJ = (IF foe CV_D_VFE] THEN 


IN 
FORSSSIGNAL (FORSK_VFEVALERR) ; 
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; 731 0791 11 
, 7 ¢ O38 11 nn 
:; 7 793 10 ELSE 
: 734 0794 18 . 
; 735 0795 1 
3. (36 p38 10 END 
> 737 079 ELSE RBYTE_A (P)); 
; 738 0798 CCB LiSBSB_FMT_EJ = 2; 
; 739 0799 
; 740 0800 8 '+ 
> 74) 0801 ! Get exnonent width (e) from format and set 
3 ms 44 ! ISBSB_EMT ; If exponent width is a VFE, check 
3; 2 80 i pange"(0:255). Else get byte from format. | 
: 744 0804 8 le 
3 745 0805 8 
; 746 0806 8 IF .ACT CFI_GETEI 
: 747 0807 8 THEN 
3; 748 0808 9 BEGIN 
: 749 0809 10 CCB CISBSB_FMT_E] = (iF .FMT_REPR CV_E_VFE] THEN | 
3; 750 pei? 11 BEGIN T VFE ; 
. Foe 0811 11 ‘ 
3° Toe balg 11 LOCAL | ; 
3; 9 0813 11 T; ‘ 
3s 754 0814 11 ; 
; t9 0815 11 T = CALL_VFE (P); : 
3; 36 0816 11 ; 
s 757 0817 11 IF .1 GEQU 256 ; 
3; 758 0818 11 THEN ; 
; 759 0819 12 BEGIN 
: 760 0820 12 FORS$SIGNAL (FORSK_VFEVALERR); 
: 761 0821 12 1 
: 762 0822 12 END | 
: 763 0823 11 ELSE 
: 764 0824 11 .T 
; 765 0825 11 
; 766 0826 11 END 
; 767 0827 9 ELSE RBYTE_A (P)); 
3; 768 0828 8 END; 
: 769 0829 8 
3; 770 0830 7 END; 
3; 771 0831 7 
s fe tts 6 END; 
. fr. 0835 6 
: 774 0834 2 END; ! End long form 
3 775 0835 
; 776 B836 2 '¢ 
3; 777 083 ' For all user data element format codes 
3; 77 0838 5 ' (explicit and default @, A, L, 0, 1, 2. Ff. E—. G, D): 
3; 779 839 5 ' Set user data element format code 
; 780 840 5 ! seen in this group, because not in an 
; 781 841 5 ! infinite format loop invoking for a user | 
3 62 ste 5 ' data element format code which doesn't exist. 
3 re? oe? 5 '- 
: 785 B45 2 IF .ACT CFI_LUSER] THEN CCB CISBSV_USER_ELEM) = 1; 
; 786 46 : 
; 787 847 '¢ 
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: uas8 Dispatch on format code and select sppropriate actions: 
: 50 
3 0881 IF .ACT CFI_ACTION) 
3 oBag CASE .FI_ACT_2 C.FMT_CODE] FROM 0 TO 13 OF 
$ 0854 5 SET 
; pps 8 [02 
3 0839 5 
3 0858 5 1+ 
; + FRA 5 ! ER or undefined format code 
; +99 2 ; Bad format: Signal_stop SYNTAX ERROR IN FORMAT (FORS_SYNERRFOR) 
3 p86¢ 5 
3 0863 6 BEGIN 
3 0864 6 FORSSSIGNAL_STO (FORSK_SYNERRFOR); 
é 0865 6 FMT_CODE = 0; 
; 806 0866 6 RETORN; 
3 0867 5 END; 
; 808 0868 5 
; 809 0869 5 C1] : 
: 810 0870 5 
3; «811 0871 5 '+ 
; 812 Bah8 5 ' No special actions required. 
> 813 0873 5 '- 
3: 814 0874 5 
; 815 0875 5 : 
: 816 0876 5 
; 817 0877 5 (2) : 
; 818 0878 5 
; 819 0879 5 '+ 
; 820 0880 5 ' LP Format reversion point: left paren of 
; 821 0881 5 ' second outer-most pair. Remeber current format 
; 822 0882 5 ! offset (ISBSW_FMT_REVER) in case more data 
; 823 0883 5 ' element in 1/0 List than data format 
3; 824 0884 5 ' codes in format. Reset push down stack to 
; 825 0885 5 ! empty (-1) since this is start of 
; 826 0886 5 ' firs grove repeat. Clear user data element 
3 Ber 0887 5 ! seen f ag (ISBSV_USER_ELEM) as a defense 
; 828 0888 5 ! against infinite loop with no data 
: 829 0889 5 ' transmit format code 
3 ts} tte : } Note: format text pointer already advanced to next byte 
: B32 498 5 
; 83 0893 6 BEGIN 
3; 834 0894 6 CCB CISBSB_FMT_DEP) = -1; 
; 835 0895 6 CCB CISBSW_FMT_REVER] = .P - .CCB CISBSA_FMT_BEG); 
; 836 0896 6 CCB CISBSV_USER_ELEM) = 0; 
3; 857 0897 5 END; ! End LP 
3 $36 898 5 
: 839 899 (3) : 
3 Bey 900 
3: 6841 901 '¢ 
; 842 206 5 ' NLP Left paren of a repeat group: Push repeat 
; 843 0903 5 ' count (ISBSW_FMT_REP) and current (ISBSA_FMT_PTR) 
3; B44 0904 5 ' onto format Stacks 


we 
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; 845 905 : jo 

; 846 BN9 

He 308 3 Pes tis $B8_FMT_DEP) CCB CISB$SB_FMT_DEP] + 1 

3 GS « 7 ¥% 

: B02 484 ° bad Heep ameghn st .CCB C1S8$B_FMT_bEP;, WORD, UNSIGNED) 
; «6851 $91 6 VECTOR LCCB bY S050 _FATsTKed. -CCB CISBSB_FMT_DEPJ;, WORD, UNSIGNED) ; 
; S26 patg 6 = .P_ = ,CCB LISBSA_FMT_ BEG]; | 
; #85 09135 6 CCB CISBSW_FMT_REPJ = T; 
> 854 0914 5 END; ! End NLP 
; 855 0915 5 
; £28 8318 5 [4] : 

3 Gor 0917 5 

; 858 0918 5 14 
; 859 0919 5 ! RP Right paren of repeat group: Decrement | 
; 860 base 5 ' current group repeat count (on top o 
; 861 0921 5 ' stack) If current group count still greater 
: B66 $358 5 ' than 0, set current format pointer back to | 
; 86 09 5 : beginning of repeat group. Else pop off 
> 864 0924 5 ' beginning of group pointer and group repeat count 

; 865 0925 5 - 

; 866 0926 5 
; 867 0927 6 IF (VECTOR CCCB CISBS$W_FMT_STKR], .CCB CISB$B_FMT_DEPJ;, WORD, UNSIGNED] : 
: eee base : = .VECTOR CCCB CISB$W_FMT_STKR], .CCB CISBSB_FMT_DEPJ;, WORD, UNSIGNED] - 1) GTR | 
; 870 0950 5 : reset pointer to address of repeat group | 
; 871 0931 5 ! 
; 872 0932 5 P = .CCB CISBSA_FMT_ BEG) ' 
3 1h, Bea7 2 _" -VECTOR CCCB CISBSW_FMT_STKP], .CCB CISB$B_FMT_DEPJ;, WORD, UNSIGNED] 
3 87> 0935 5 ' pop off pointer and repeat count | 
; 876 0936 5 ! 
; 877 0937 5 CCB CISBSB_FMT_DEP] = .CCB CISBSB_FMT_DEP) - 1; 

; 878 0938 5 

; 879 0939 5 (52 : 

; 880 0940 5 

; 881 0941 5 1 
; 882 0942 5 ! EOF End of format: 

; 883 0943 5 ! If not end of user 1/0 List (EL_SIZE=0) 

; 884 0944 5 ' and no user data element format code 

; 885 0945 5 ! (ISBSV_USER_ELEM=0), then Signal_stop. INFINITE 

; 886 0946 5 ! FORMAT LOOP (FORS_INFFORLOP). ‘ 
; 887 0947 5 ! Reset current format pointer to reversion point 
; Ht 0948 2 ! (ISBSW_FMT_REVER). Initialize format stack depth. 
; 889 0949 !e 
; 890 0950 5 
; 891 0951 6 BEGIN 

3 892 0958 6 P = .CCB CISBSA_FMT_BEG) + .CCB CISBS$W_FMT_REVER); 

: 893 0998 6 ccB CISBSB_FMT_DEPJ~= -1; | 
; 895 0984 6 IF .EL_SIZE GTRU 0 AND NOT .CCB CISBS$V_USER_ELEM) 
3 £38 b32$ § THEN 
; 89 95 BEGIN 
; 898 958 7 FORSSSIGNAL_STO (FORSK_INFFORLOO); 
; 899 959 7 FMT CODE = 0; 
; 900 960 7 RETORN; 
: 901 961 6 END; 
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i P Scale factor (sP): -128 =< s =< 127 

i Convert unsi a ,word width (w) (ISBSW_FMT_W) 
to signed byte ('s) and save in ISBSB_FMT_P. 


BEGIN 
he CISBSB_FMT_P] = .CCB CISBSW_FMT_w); 


'4 
t S, SS Restore option of + to processor. 


BEG 
eco. tisesv_sP3 = 0; 
END; 


‘+ 
SP Force optional + to appear 


BEGIN 
CCB CISB$V_SP) = 
END; 


t+ 
BN Treat bianks as nulls on numeric input. 


BEGIN 
CCB CISB$V_BN) = 
END; 


1+ 
: BZ Treat blanks as zeroes on numeric input. 


BEGIN 
CCB CISB$V_BN) = 0; 
END 


-o 


ins - os } 
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; 959 1918 

. 1m - nove butter potatoe eo poet 

3 ' Tn ove buffer pointer to position n 

968 19 é i : | 

; 96 10 

> 964 1024 6 BEGIN 

: 965 1025 6 CCB CLUBSA_BUF_PTR] = .CCB CLUBSA_BUF_BEG] + (.CCB CISBSW_FMT_WJ] =- 1); 

: 966 1026 2 END; 

; 967 1027 

> 968 1028 5 C12] : 

; 969 1029 5 

; 970 18 » > '+ 

>; 971 1031 5 ' TLn Move buffer pointer left n positions | 

; 97 1038 ; = 

; 97 103 

: 974 1034 6 BEGIN 

| ie} 1932 2 CCB CLUBSA_BUF_PTR] = .CCB CLUBSA_BUF_PTR] - .CCB CISBSW_FMT_wJ; 

; 977 1037 6 IF .CCB CLUBSA_BUF_PTR] LSSA .CCB CLUBSA_BUF _BEG) 

; 978 1038 6 THEN 

; 979 1039 6 CCB CLUBSA_BUF_PTR] = .CCB CLUBSA_BUF _BEG); 

; 980 1040 6 

; 981 1041 5 END; 

; Mok 5 

; 98 1043 5 (13) : 

: 984 1044 5 | 

; #985 1045 5 + 

: 986 1046 5 ! TRn Move buffer pointer right n spaces. | 

; 987 1047 5§ ! Note: as of VMS Release 2, the format nx 

; 988 1048 5 ! is equivalent to TRn. The old nX code 

; 989 1049 5 ; is no longer generated but is supported 

: 990 1050 5 ! for compatibility. 

: 991 1051 § = 

: 338 1036 5 

; 99 1053 6 BEGIN 

; 99% 1054 6 CCB CLUBSA_BUF_PTR] = .CCB CLUBSA_BUF_PTR] + .CCB CISBSW_FMT_Wd; 

; 995 1055 5 END; 

; 996 1056 5 TES; 

: 997 1057 5 

; 998 1058 5 '+ 

; 999 1059 5 ! End of loop - continue if just format control 

: 1000 1060 5 ! - n(, )) or not dependent on read/write 

3 1901 190) 2 and doesn't access data buffer (P) 

5 1908 1968 5 ! EXITLOOP for format codes which access user data. 

3 1004 1064 5 ' (ER or explicit or default A, L, 0, I, 2, Ff. E. Gor D), 

3; 1005 1065 5 ' EXITLOOP for format codes which access data 

: 1006 1268 5 : buffer (xX, H, Q) EXITLOOP for format codes | 

: 1007 1067 5 ! which depend on whether read or write (end 

: 1008 1068 2 : of format, /, $, :, T). 

; 1009 1069 - 

; 1010 1070 5 

3 1011 1071 5 END 

3 Ole 1076 4 END 

: 101 107 UNTIL .ACT CFI_EXITI; 

3 1014 1074 

3 1015 1075 '¢ 


4 


Be cette csi esines commana tong tees 1-80-1388 3:93:08 — EPSantLSSReSFORFMTINT 082; 1 


1 
1 
3 3 
s 7 
a | 
1 
1 


— 3s 4 3 9.» 


} Reset format code and updated format text pointer in ISB. 


= ,FMT_CODE; 
= .P; 


Page (35 
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> 1024 1083 + 

; 1025 1084 ' Default data format codes - set defaults based on size of 

; 10 $ 1085 ! each user data element even if inside a format code repeat 

; 1° i 1388 since the size could be different for each user data element 

: 1029 1088 

: 1030 1089 IF_.FMT_CODE GEQU _DA 

: 1031 1090 THEN 

. et? oe: 

: 1034 1998 CASE .FMT_CODE FROM _DA TO _DD OF 

3 Se? 1094 SET 

3 10 1095 

: 1037 1096 C_DAJ : 

| . 

; 1040 1099 3 i Default A: set w field (ISBSW_FMT_W) from 

: 1041 1100 ; ' size of user data element 

We 1B . 

: 1044 1108 3 CCB CISBSW_FMT_W] = .EL_SIZE;: 

3; 1045 1104 3 

> 1046 1105 3 C_0LJ : 

. re : 

> 1049 1108 3 i Default L: set w field (ISBSW_FMT_W) to 2 

 108t 1140 3 id 

: 1058 1111 3 CCB CISBSW_FMT_W) = 2; 

: 105 W1¢ ; 

: 1054 111 {_b1] : 

eS ' 

: 1057 1116 3 i Default I: Set w field to 7 if element is smaller than 
; 1058 1117 3 ! 4 bytes else set it to 12. 

3B : 

; ei 1139 3 IF .EL_SIZE LSSU 4 THEN CCB CISBSW_FMT_W) = 7 ELSE CCB CISBSW_FMT_W] = 12; 
: 1963 1122 3 (_DO. _pZ) : 

BORE ; 

> 1066 1125 3 i Default 0, Z. Set to the width that would allow 0 — 

3; 1067 1138 ; ' format plus a space. \\ Note: For gonngt tent Sty with 
: 1068 11 ' previous releases, the sizes for 1, 2 and 4 bytes must 
3; 1069 1128 ; ' be 7, 7 and 12 respectively. \\ 

eH ‘ 

: 1078 1131 CCB CISBSW_FMT_W) = MAX (7, MIN (65535, (((8*.EL_SIZE)+2)/3)+1)); 
: 107 1138 C_DF, _DE. _DG> _DB) : 

Be OE ' 

; 1076 1138 i Default F, E. G, D: Set w and e fields as is appropriate 
: 1077 1139 ! to the element size. Note that anything that is not 

; 1078 Ne ! 8 (REAL*8) or 16 (REAL*16) is assumed to be 4 (REAL*4), 
3 Ht 1138 : but check for 4 first. 
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FORSSFMT_INTRP Fortran Format Statement Interpreter 16-Sep-1 1384 00: 43:4 AX-11 Bliss-32 V4.0-74 , Page 
14-Sep-19 FORRTL.SRCJFORFMTINT.B32;1 
H 1138 1197 1 
: 1139 1198 1 END ! End of module FORSSFMT_INTRP 
: 1140 1199 1 
3 1141 1200 0 ELUDOM 
3 PSECT SUMMARY 
: Name Bytes Attributes 
: _FORSCODE 1030 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 
; Library Statistics 
fee Ei ae, ae ee Oe STUECLE Socewsae Pages Processing 
; File Total Loaded Percent Mapped Time 
: _$255$DUA28:CSYSLIBISTARLET.L32;1 9776 0 0 581 00:01.1 
; ~$255$DUA28:CFORRTL. OBJ JFORLIB.L32;1 711 211 29 52 00:00.6 
3 ~$255$DUA28:CFORRTL.OBJIRTLLIB.L32;1 36 0 0 8 00:00.1 
5 COMMAND QUALIFIERS 
: RIT IR CENT FOLD Fes A APT SNEEE PF PTRRER IL LOMG EERE GREY See SOUR LORE re MSRC$:FORFMTINT/UPDATE=(ENHS$:FORFMTINT 
3; Size: 922 code + 108 data bytes 
; Run Time: 00:29.5 
; Elapsed Time: 01:23.3 
3; Lines/CPU Min: gaa 
3 Lexemes/CPU-Min: 25045 
; g 


poe | Used: 386 pages 
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